home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_b / st.act < prev    next >
Text File  |  1995-04-22  |  6KB  |  377 lines
  1.  
  2. MODULE ; ST.ACT 
  3.  
  4. ; Symbol table lister for ACTION! 
  5. ; compiler.  Lists local variables 
  6. ; per PROC/FUNC and globals at end 
  7. ; of compilation. 
  8.  
  9. ; copyright 1983 
  10. ; by Action Computer Services 
  11. ; All Rights Reserved 
  12.  
  13. ; version 1.0 
  14. ; last modified November 6, 1983 
  15.  
  16. ; user options: 
  17. ; 
  18. ; change Open call in SPLEnd to get 
  19. ; listing to go to disk 
  20.  
  21.  
  22. DEFINE STRING = "CHAR ARRAY" 
  23. DEFINE JMP = "$4C" ; JMP addr16 
  24.  
  25. TYPE INSTR=[BYTE op CARD addr] 
  26. INSTR Segvec=$4C6, DCLvec=$4D4 
  27. INSTR SPLvec=$4DD 
  28.  
  29. TYPE ENTRY = 
  30. [ 
  31. ; STRING name(?) 
  32.   BYTE vtype 
  33.   CARD adr 
  34.   BYTE numargs 
  35. ; BYTE ARRAY argTypes(8) 
  36. ] 
  37.  
  38. BYTE oldDevice, curBank=$4C9 
  39. BYTE pf, Zop=$8A, tZop 
  40. CARD curproc=$8E 
  41. ENTRY POINTER e 
  42. CHAR ARRAY cmdLine(0)=$590 
  43. BYTE ARRAY bank(0)=$D500 
  44. BYTE ARRAY zpage(32), temps(16) 
  45.  
  46.  
  47. PROC PrintH(CARD v) 
  48.   PrintF("%H", v) 
  49. RETURN 
  50.  
  51.  
  52. PROC BaseType(BYTE et) 
  53.   et = et & $7 
  54.  
  55.   IF     et=1 THEN Print("CHAR") 
  56.   ELSEIF et=2 THEN Print("BYTE") 
  57.   ELSEIF et=3 THEN Print("INT") 
  58.   ELSEIF et=4 THEN Print("CARD") 
  59.   FI 
  60. RETURN 
  61.  
  62.  
  63. BYTE FUNC GetType(BYTE et) 
  64.   CHAR ch 
  65.   BYTE pfFlag, t, oldT 
  66.   ENTRY POINTER next 
  67.   STRING name 
  68.  
  69.   pfFlag = 0 
  70.  
  71.   IF et=39 THEN ; user type 
  72.     Print("TYPE=") 
  73.     name = e + 3 
  74.     next = name + name(0) + 1 
  75.     ch = '[ 
  76.     oldT = 0 
  77.     WHILE next.vtype<128 DO 
  78.       et = next.vtype & $7 
  79.       If et=0 THEN EXIT FI 
  80.       IF et=oldT THEN 
  81.         Print(", ") 
  82.       ELSE 
  83.         Put(ch) 
  84.         BaseType(et) 
  85.         Put(' ) 
  86.       FI 
  87.       oldT = et 
  88.       Print(name) 
  89.       ch = '  
  90.       name = next + 3 
  91.       next = name + name(0) + 1 
  92.     OD 
  93.     IF ch='[ THEN Put('[) FI 
  94.     Put(']) 
  95.     RETURN(0) 
  96.   FI 
  97.  
  98.   IF et=27 THEN ; DEFINE 
  99.     PrintF("DEFINE = ""%S""", e+3) 
  100.     RETURN(0) 
  101.   FI 
  102.  
  103. ; get basic type 
  104.   BaseType(et) 
  105.  
  106. ; only record vars less than 128 
  107.   IF et<128 THEN ; record 
  108.     IF (et&7)=0 THEN 
  109.       Print("RECORD") 
  110.       IF (et&8)=8 THEN 
  111.         Print(" POINTER") 
  112.       FI 
  113.     ELSE 
  114.       Print(" record field") 
  115.     FI 
  116.     RETURN(0) 
  117.   FI 
  118.                 
  119.   IF et&$10 THEN ; ARRAY 
  120.     Print(" ARRAY") 
  121.   ELSEIF et&$40 THEN ; PROC or FUNC 
  122.     pfFlag = 1 
  123.     IF (et&$F7)=$C0 THEN ; PROC 
  124.       Print("PROC") 
  125.     ELSE ; FUNC 
  126.       Print(" FUNC") 
  127.     FI 
  128.   FI 
  129. RETURN(pfFlag) 
  130.  
  131.  
  132. PROC PrintEntry(STRING n) 
  133.   DEFINE MAX = "15" 
  134.   BYTE i, et 
  135.   STRING name(MAX+1), t 
  136.   BYTE ARRAY argTypes 
  137.  
  138. ; get the name 
  139.   SetBlock(name+1, MAX, '.) 
  140.   SCopyS(name, n, 1, MAX) 
  141.   name(0) = MAX 
  142.  
  143. ; get address of entry info 
  144.   e = n + n(0) + 1 
  145.    
  146.   et = e.vtype 
  147.   IF et=$88 THEN RETURN FI ; undeclared 
  148.  
  149.   PrintF("%S ",name) 
  150.  
  151.   IF et=27 THEN ; DEFINE 
  152.     Print("     ") 
  153.   ELSE 
  154.     PrintH(e.adr) 
  155.   FI 
  156.   Put(' ) 
  157.  
  158.   IF GetType(et) THEN ; PROC or FUNC 
  159.     Put('() 
  160.     argTypes = e + 3 
  161.     t="" 
  162.     FOR i = 1 TO e.numargs DO 
  163.       Print(t) 
  164.       GetType(argTypes(i)%$80) 
  165.       t = ", " 
  166.     OD 
  167.     Put(')) 
  168.   FI 
  169.  
  170.   PutE() 
  171. RETURN 
  172.  
  173.  
  174. PROC DumpST(CARD POINTER base) 
  175.   CARD loc, i 
  176.   BYTE low=loc, high=loc+1, ibest 
  177.   BYTE ARRAY stLow, stHigh, flags(256) 
  178.   STRING best, worst(0)="|" 
  179.  
  180.   Zero(flags, 256) 
  181.   stHigh = base^ 
  182.   stLow = stHigh + 256 
  183.  
  184.   DO 
  185.     best = worst 
  186.     FOR i = 0 TO 255 DO 
  187.       high = stHigh(i) 
  188.       IF high#0 AND flags(i)=0 THEN 
  189.         low = stLow(i) 
  190.         IF SCompare(loc, best)<0 THEN 
  191.           best = loc 
  192.           ibest = i 
  193.         FI 
  194.       FI 
  195.     OD 
  196.    
  197.     IF best=worst THEN EXIT FI 
  198.  
  199.     flags(ibest) = 1 
  200.     PrintEntry(best) 
  201.   OD 
  202. RETURN 
  203.  
  204.  
  205. PROC Save() 
  206. ; save state of variables used by 
  207. ; both compiler and library routines 
  208.  
  209.   bank(0) = 0 ; init library routines 
  210.   tZop = Zop 
  211.   MoveBlock(zpage, $B0, $1B) ; to $CA 
  212.   MoveBlock(temps, $5F0, 16) 
  213.  
  214.   device = 5 
  215. RETURN 
  216.  
  217.  
  218. PROC Restore() 
  219. ; restore state of variables used by 
  220. ; both compiler and library routines 
  221.  
  222.   Zop = tZop 
  223.   MoveBlock($B0, zpage, $1B) ; to $CA 
  224.   MoveBlock($5F0, temps, 16) 
  225.  
  226. ; device = oldDevice 
  227.   bank(curBank) = 0 
  228. RETURN 
  229.  
  230.  
  231. PROC SegEnd() 
  232.   Save() 
  233.   IF pf THEN ; print locals 
  234.     PrintF("%ELocal declarations for %S:%E", curproc) 
  235.     DumpST($B3) 
  236.   ELSE 
  237.     pf = 1 
  238.   FI 
  239.   Restore() 
  240. RETURN 
  241.  
  242.  
  243. BYTE FUNC DclEnd() 
  244.   BYTE token=$C2 
  245.   CARD addr1, addr2 
  246.  
  247.   DEFINE PLA = "$68", 
  248.          STA = "$8D", 
  249.          LDA = "$AD", 
  250.          PHA = "$48" 
  251.  
  252. ; find out where we came from 
  253.   [    
  254.     PLA 
  255.     STA addr1 
  256.     PLA 
  257.     STA addr1+1 
  258.     PLA 
  259.     STA addr2 
  260.     PLA 
  261.     STA addr2+1 
  262.     PHA 
  263.     LDA addr2 
  264.     PHA 
  265.     LDA addr1+1 
  266.     PHA 
  267.     LDA addr1 
  268.     PHA 
  269.   ] 
  270.   IF addr2<$B000 THEN ; new MODULE 
  271.     SegEnd() 
  272.     pf = 0 
  273.   FI 
  274. RETURN(token) 
  275.  
  276.  
  277. PROC SPL() ; dummy proc for call below 
  278.  
  279.  
  280. PROC SPLEnd() 
  281.   BYTE nxttoken=$D3 
  282.   CARD codeBase=$491, codeSize=$493 
  283.   CARD nxtaddr=$C9 
  284.   STRING inbuf(0)=$5C8, name 
  285.  
  286.   DEFINE PLA = "$68", 
  287.          STA = "$8D" 
  288.  
  289. ; oldDevice = device 
  290.   Save() 
  291.  
  292.   Close(5)  Open(5, "P:", 8) 
  293.  
  294.   IF nxttoken=30 THEN ; command line 
  295.     name = nxtaddr 
  296.   ELSE ; editor buffer 
  297.     name = inbuf 
  298.   FI 
  299.   PrintF("%E%ESymbol Table for %S%E%E", name) 
  300.  
  301.   pf = 0 ; no proc decl yet 
  302.  
  303. ; JSR for return so that we come 
  304. ; back here after compilation 
  305.   [    
  306.     PLA 
  307.     STA SPL+1 
  308.     PLA 
  309.     STA SPL+2 
  310.   ] 
  311.   SPL = SPL + 1 ; get right address 
  312.   Restore() 
  313.   SPL() 
  314.  
  315.   Save() 
  316.  
  317.   IF pf THEN ; print locals 
  318.     PrintF("%ELocal declarations for %S:%E", curproc) 
  319.     DumpST($B3) 
  320.   FI 
  321.  
  322.   PrintF("%E%EGlobal declarations:%E%E") 
  323.   DumpST($B1) 
  324.  
  325.   PrintF("%E%ECode base = %H, code size = %U%E", 
  326.          codeBase, codeSize) 
  327.  
  328.   Close(5) 
  329.   Restore() 
  330. RETURN 
  331.  
  332.  
  333. ; only code generated before Init is 
  334. ; allocated space.  Init will be 
  335. ; garbage collected (well kind of). 
  336.  
  337. PROC Init() 
  338.   CARD codeBlock, bsize, csize, nBlock 
  339.   CARD POINTER cur, next 
  340.   CARD ARRAY codeBase=$491 
  341.  
  342. ; link in our routines 
  343.   Segvec.op = JMP 
  344.   Segvec.addr = SegEnd 
  345.   Dclvec.op = JMP 
  346.   Dclvec.addr = DclEnd 
  347.   SPLvec.op = JMP 
  348.   SPLvec.addr = SPLEnd 
  349.  
  350. ; allocate our routine so it won't 
  351. ; go away. 
  352.   codeBlock = codeBase^ - 4 
  353.   next = $80 ; AFbase 
  354.   DO 
  355.     cur = next 
  356.     next = next^ 
  357.   UNTIL next=0 OR next=codeBlock OD 
  358.  
  359.   IF next=0 THEN 
  360.     PutE()   Put($FD) 
  361.     PrintE("I can't allocate space for your code") 
  362.     PrintE("You better Boot and try again!") 
  363.     RETURN 
  364.   FI 
  365.  
  366. ; assume we can split block 
  367.   csize = @codeBlock-codeBlock 
  368.   nBlock = next^ 
  369.   bsize = next(1) - csize 
  370.   next = @codeBlock 
  371.   cur^ = next 
  372.   next^ = nBlock 
  373.   next(1) = bsize 
  374.   codeBase^ = @codeBlock 
  375. RETURN 
  376.  
  377.